home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCROLL.SWG / 0005_Write w- Scroll Control.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-08  |  4KB  |  110 lines
  1. (*
  2. ===========================================================================
  3.  BBS: Canada Remote Systems
  4. Date: 06-01-93 (06:21)             Number: 24456
  5. From: LOU DUCHEZ                   Refer#: NONE
  6.   To: MICHAEL DEAKINS               Recvd: NO  
  7. Subj: ANSI, BATCH FILE EXEC'ING      Conf: (1221) F-PASCAL
  8. ---------------------------------------------------------------------------
  9. MD>I have two questions. First, How can I display ANSI files from a Pascal
  10. MD>program by using the CON driver (read: ANSI.SYS) instead of going to the
  11. MD>trouble of writing a terminal emulator, and still remain
  12. MD>window-relative? I used TP5.5's WRITE procedure to write to a file
  13. MD>assigned to the CON device instead of the CRT unit's standard OutPut,
  14. MD>but this obliterated my status line at the bottom of the screen when the
  15. MD>ANSI file scrolled. Is there an easy way to write to the CON device
  16. MD>while remaining window-relative without having to modify ANSI.SYS or
  17. MD>write a terminal emulation procedure?
  18. MD> My second question: How can I call a batch file from within a Pascal
  19. MD>program and pass %1-%9 parameters to it? I'm aware of the EXEC
  20. MD>procedure, but doesn't that only work on executables?
  21.  
  22. Second question first: you're right about EXEC calling only executables.
  23. So try calling "COMMAND.COM" as your program, and give it parameters of
  24. "/C " plus the batch file name plus whatever arguments you intend to pass.
  25. (That tells the system to run a single command out of DOS.)  Look up
  26. ParamCount and ParamStr() to see how Pascal uses command-line parameters.
  27.  
  28. First question second: you know, I addressed this problem just yesterday
  29. trying to write a program.  I concluded that, if you're going to bypass
  30. CRT, you need to do a lot of "manual" work yourself to keep a window
  31. going.  Let me show you the tools I devised:
  32. *)
  33.  
  34.  
  35. {---PROCEDURE ATSCROLL: SCROLLS A SCREEN REGION UP OR DOWN (negative or
  36.    positive number in LINESDOWN, respectively) }
  37.  
  38. procedure atscroll(x1, y1, x2, y2: byte; linesdown: integer);
  39. var tmpbyte, intbyte, clearattrib: byte;
  40. begin
  41.   if linesdown <> 0 then begin
  42.     clearattrib := foxfore + foxback shl 4;
  43.     x1 := x1 - 1;
  44.     y1 := y1 - 1;
  45.     x2 := x2 - 1;
  46.     y2 := y2 - 1;
  47.     if linesdown > 0 then intbyte := $07 else intbyte := $06;
  48.     tmpbyte := abs(linesdown);
  49.     asm
  50.       mov ah, intbyte
  51.       mov al, tmpbyte
  52.       mov bh, clearattrib
  53.       mov ch, y1
  54.       mov cl, x1
  55.       mov dh, y2
  56.       mov dl, x2
  57.       int 10h
  58.       end;
  59.     end;
  60.   end;
  61.  
  62.  
  63.  
  64. {---FUNCTION YPOS: Returns the line the cursor is on.  I wrote it because
  65.    I don't always trust WHEREY (or WHEREX): they report, for example, the
  66.    cursor position relative to a text window.  So I had it lying around,
  67.    and I opted to use it in my routines.                                 }
  68.  
  69. function ypos: byte;
  70. var tmpbyt: byte;
  71. begin
  72.   asm
  73.     mov ah, 03h
  74.     mov bh, 0
  75.     int 10h
  76.     mov tmpbyt, dh
  77.     end;
  78.   ypos := tmpbyt + 1;
  79.   end;
  80.  
  81.  
  82.  
  83. {--- PROCEDURE WRITEANDFIXOVERHANG: I use it in place of WRITELN in my
  84.     program: before writing a line of text, it checks if there's room
  85.     at the bottom of the screen.  If not, it scrolls the screen up
  86.     before writing.  Keep in mind that this program is bent on preserving
  87.     the top three or four screen lines, not the bottom lines. }
  88.  
  89. procedure writeandfixoverhang(strin: string);
  90. const scrollat: byte = 24;
  91. var overhang: byte;
  92. begin
  93.   if ypos >= scrollat then begin
  94.     overhang := ypos - scrollat + 1;
  95.     atscroll(0, 4 + overhang, 0, 80, 25, -overhang);
  96.     movecursor(1, ypos - overhang);
  97.     end;
  98.   writeln(strin);
  99.   end;
  100.  
  101. {
  102. So assuming your text lines don't get too long (line longer than 160 chars),
  103. these routines will keep the top of your screen from getting eaten.  If you
  104. want to preserve space at the bottom of the screen instead (or both top and
  105. bottom), change WRITEANDFIXOVERHANG.
  106.  
  107. BTW, if there are any compiling problems, let me know.  I took out all the
  108. stuff that applied specifically to my application -- I might have stupidly
  109. changed something you need ... }
  110.